home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / FILES.I < prev    next >
Encoding:
Text File  |  1993-12-10  |  24.6 KB  |  3 lines
  1. ⓪ IMPLEMENTATION MODULE Files; (* V#144 *)⓪ (*$Y+,R-*)⓪ ⓪ (*⓪"22.01.88  TT  Get/SetDateTime korrigiert, Close/Remove: A3 richtig nach call⓪"15.05.88  TT  Bei Open/Create ist 'appendSeqTxt' auf Units erlaubt;⓪0In checkUnit hatt 'res' nun immer definierten Wert.⓪"03.07.88  TT  @CheckError meldet Fehler und liefert FALSE, wenn 'f' in⓪0ErrField zeigt.⓪"01.09.88  TT  Sys-Funktionen werden nicht autom. bei unterstem Level-Ende⓪0abgemeldet.⓪"25.10.88 TT   CatchRemoval-Aufruf, Files des untersten Levels werden auch⓪0geschlossen.⓪"04.08.89 TT   Kein 'del'-Aufruf mehr in Open; Datenpuffer f. 'readSeqTxt'⓪"05.09.88  TT  Get/SetDateTime fragen keinen Fehler mehr ab, weil TOS < 1.4⓪0undefinierte Werte liefert⓪"31.01.90  TT  unitOpen überschrieb die Ausgaberoutine, was bei Ausgabe⓪0auf eine Unit zu einem JMP ins Ungewisse führte (es lag⓪0daran, daß der 'console'-Move mit .L statt .W gemacht wurde).⓪"16.07.90  TT  Bei Close() nach Open() wird das Datei-Datum aktualisiert.⓪"15.09.90  TT  Der Dateiname kann nun 139 Zeichen lang sein.⓪"31.01.91  TT  Open/Create geht nun auch mit Umlauten im Namen, da die⓪0Umlaute nicht mehr von Klein nach Groß gewandelt werden.⓪"02.08.91  TT  GetFileName kopiert _Rest_ vom Namen, falls er nicht paßt.⓪"27.10.91  TT  SetDateTime löscht nun wirklich 'state' und nicht irgendein⓪0Word irgendwo im Speicher.⓪"10.12.93  TT  Create (.. appendSeqTxt, ..) nun auch unter MTOS möglich (ging⓪0nicht, weil Datei mit "readOnly" geöffnet wurde und nur das⓪0alte TOS dies nicht bemängelt hatte).⓪ *)⓪ ⓪ ⓪ FROM SYSTEM IMPORT ASSEMBLER, ADDRESS, LONGWORD, ADR, WORD, TSIZE;⓪ ⓪ FROM SysTypes IMPORT ScanDesc;⓪ ⓪ FROM SysCtrl IMPORT GetScanAddr, ScanBack;⓪ ⓪ FROM Clock IMPORT Time, Date, PackTime, PackDate, UnpackTime, UnpackDate,⓪(CurrentTime, CurrentDate;⓪ ⓪ FROM Strings IMPORT Upper, Length, Copy, Assign, Pos, Delete, Insert, StrEqual;⓪ ⓪ FROM Storage IMPORT SysAlloc, DEALLOCATE;⓪ ⓪ FROM ResCtrl IMPORT RemovalCarrier, CatchRemoval;⓪ ⓪ FROM FileBase IMPORT CloseFile, HandleError, Unit, UnitDriver,⓪(UDriver, UDataProc, UCloseProc, UFlushProc, URStrProc,⓪(UWStrProc, UGChrProc;⓪ ⓪ FROM MOSConfig IMPORT FileErrMsg;⓪ ⓪ FROM MOSGlobals IMPORT fFileNotOpen, fInternalErr1, fWasNotOpen, fOutOfMem,⓪(fFileExists, fNoReadAllowed, fNameTooLarge, fBadOp, fBadAccess,⓪(fFileNotClosed, MemArea;⓪ ⓪ FROM PrgCtrl IMPORT TermCarrier, CatchProcessTerm, EnvlpCarrier, SetEnvelope;⓪ ⓪ FROM StrConv IMPORT IntToStr;⓪ ⓪ (*$I FileDesc.Icl *)⓪ ⓪ CONST   BufferSize = 512;  (* Größe f. Daten-Puffer bei 'readSeqTxt' *)⓪ ⓪ (*$O+*)⓪ TYPE File = POINTER TO FileDesc;⓪ (*$O-*)⓪ ⓪%FileList = POINTER TO FileField;⓪%FileField = RECORD⓪3next: FileList;⓪3owner: File;⓪3marked: BOOLEAN;⓪1END;⓪ ⓪ TYPE seekMode = ( fromBegin, fromPos, fromEnd );⓪ ⓪ CONST MaxWarn = 4;⓪&MaxErrorNo = -142;⓪ ⓪ VAR ErrorTable: ARRAY [MaxErrorNo..MaxWarn] OF INTEGER;⓪$ErrTblEnd, ErrTblBeg: ADDRESS;⓪$OpenFiles: FileList;⓪$ModLevel: INTEGER;⓪$strRes: BOOLEAN;⓪$unitSize: CARDINAL;⓪$fileSize: LONGCARD;⓪ ⓪ ⓪ PROCEDURE Init (VAR f: File);⓪"BEGIN⓪$f:= NIL⓪"END Init;⓪ ⓪ ⓪ PROCEDURE Abort (VAR f: File);⓪"BEGIN⓪$HALT⓪"END Abort;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE OpErr (n:LONGWORD):File;⓪"BEGIN⓪$ASSEMBLER⓪(MOVEQ   #MaxWarn,D0⓪(SUB.L   -(A3),D0⓪(LSL.L   #1,D0⓪(ADD.L   ErrTblBeg,D0⓪(MOVE.L  D0,(A3)+⓪$END⓪"END OpErr;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE seek (offset : LONGINT; handle: INTEGER; base: seekMode):LONGINT;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L  -(A3),-(A7)⓪(MOVE.L  -(A3),-(A7)⓪(MOVE    #$42,-(A7)⓪(TRAP    #1⓪(ADDA.W  #10,A7⓪(MOVE.L  D0,(A3)+⓪$END⓪"END seek;⓪ (*$L+*)⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE del (VAR name: ARRAY OF CHAR);⓪"BEGIN⓪$ASSEMBLER⓪(SUBQ.L  #2,A3⓪(MOVE.L  -(A3),-(A7)⓪(MOVE    #$41,-(A7)            ; DELETE⓪(TRAP    #1⓪(ADDQ.L  #6,A7⓪$END;⓪"END del;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE clos (h: WORD): LONGINT;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE    -(A3),-(A7)⓪(MOVE    #$3E,-(A7)            ; CLOSE⓪(TRAP    #1⓪(ADDQ.L  #4,A7⓪(MOVE.L  D0,(A3)+⓪$END⓪"END clos;⓪ ⓪ (*$L-*)⓪ PROCEDURE LowerWord (l:LONGWORD):WORD;⓪"BEGIN⓪$ASSEMBLER⓪&MOVE.L  -(A3),D0⓪&MOVE    D0,(A3)+⓪$END⓪"END LowerWord;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE Opened (f: File): BOOLEAN;⓪"BEGIN⓪$ASSEMBLER⓪(; A1, D2 nicht zerstören !⓪(MOVE.L  -(A3),D0⓪(BEQ     FA⓪(MOVE.L  OpenFiles,A0⓪%L0 MOVE.L  A0,D1⓪(BEQ     FA⓪(CMP.L   FileField.owner(A0),D0⓪(BEQ     TR⓪(MOVE.L  FileField.next(A0),A0⓪(BRA     L0⓪%TR MOVE    #1,(A3)+⓪(RTS⓪%FA CLR     (A3)+⓪$END⓪"END Opened;⓪ ⓪ (*$L-*)⓪ PROCEDURE ListAppend (f:File; VAR res: LONGINT): BOOLEAN;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L  -8(A3),(A3)+⓪(JSR     Opened⓪(TST     -(A3)⓪(BEQ     T0⓪%EE MOVE    #fFileNotClosed,D0⓪(MOVE.L  -(A3),A0⓪(SUBQ.L  #4,A0⓪(MOVE    D0,File.state(A0)⓪(CLR     (A3)+⓪(RTS⓪%T0 LEA     OpenFiles,A0⓪(MOVE.L  (A0),-(A7)⓪(MOVE.L  A0,(A3)+⓪(MOVE.L  fileSize,(A3)+⓪(JSR     SysAlloc⓪(MOVE.L  (A7)+,D0⓪(LEA     OpenFiles,A0⓪(MOVE.L  (A0),D1⓪(BNE     T1⓪(MOVE.L  D0,(A0)⓪(MOVE    #fOutOfMem,D0⓪(BRA     EE⓪%T1 MOVE.L  D1,A1⓪(MOVE.L  D0,FileField.next(A1)⓪(SUBQ.L  #4,A3⓪(MOVE.L  -(A3),FileField.owner(A1)⓪(MOVE    #1,(A3)+⓪$END⓪"END ListAppend;⓪ ⓪ (*$L-*)⓪ PROCEDURE ListRemove (VAR f: File);⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L  -(A3),A0        ; ^FILE⓪(MOVE.L  (A0),D0⓪(LEA     OpenFiles,A1⓪%L0 MOVE.L  (A1),A2⓪(MOVE.L  A2,D2⓪(BEQ     E0⓪(CMP.L   FileField.owner(A2),D0⓪(BNE     T0⓪(MOVE.L  FileField.next(A2),(A1)⓪(MOVE.L  A2,-(A7)⓪(MOVE.L  A7,(A3)+⓪(CLR.L   (A3)+⓪(JSR     DEALLOCATE⓪(ADDQ.L  #4,A7⓪(RTS⓪%T0 LEA     FileField.next(A2),A1⓪(BRA     L0⓪%E0 CLR.L   (A0)⓪$END⓪"END ListRemove;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE free (VAR f:File; res:LONGINT);⓪"BEGIN⓪$ASSEMBLER⓪(JSR     OpErr⓪(MOVE.L  -(A3),-(A7)     ; error-code⓪(MOVE.L  -4(A3),-(A7)    ; ADR (f)⓪(JSR     ListRemove⓪(MOVE.L  (A7),A0         ; ADR (f)⓪(MOVE.L  (A0),A1⓪(MOVE.L  File.buffer(A1),D0⓪(BEQ     noBuf⓪(MOVE.L  D0,-(A7)⓪(MOVE.L  A7,(A3)+        ; f.buffer⓪(CLR.L   (A3)+⓪(JSR     DEALLOCATE⓪(ADDQ.L  #4,A7⓪&noBuf⓪(MOVE.L  (A7),(A3)+      ; ADR (f)⓪(CLR.L   (A3)+⓪(JSR     DEALLOCATE⓪(MOVE.L  (A7)+,A0⓪(MOVE.L  (A7)+,(A0)⓪$END⓪"END free;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE init0 (f: File);⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L  -(A3),A0⓪(MOVEQ   #0,D0⓪(MOVE.B  D0,File.lastch(A0)⓪(MOVE.B  D0,File.prevch(A0)⓪(MOVE.W  D0,File.getlast(A0)⓪(MOVE.W  D0,File.eof(A0)⓪(MOVE.W  D0,File.eol(A0)⓪(MOVE.W  D0,File.skipLF(A0)⓪(MOVE.W  D0,File.state(A0)⓪(MOVE.W  #1,File.chkeof(A0)⓪(MOVE.B  #26,File.eofchr(A0)⓪$END⓪"END init0;⓪ ⓪ (*$L-*)⓪ PROCEDURE fileUpper (VAR s: ARRAY OF CHAR);⓪"(* "Upper" für Dateinamen: berücksichtigt nur die unteren 128 Zeichen *)⓪"VAR n: CARDINAL;⓪"BEGIN⓪$(*⓪$FOR n:= 0 TO HIGH (s) DO⓪&IF s[n]='' THEN RETURN END;⓪&IF s[n]<CHR(128) THEN s[n]:=CAP(s[n]) END⓪$END⓪$*)⓪$ASSEMBLER⓪(MOVE.W  -(A3),D1⓪(MOVE.L  -(A3),A1⓪(CLR.W   D0⓪&luup:⓪(MOVE.B  (A1)+,D0⓪(BEQ     ende⓪(BMI     next⓪(JSR     @CAP    ;/A2⓪(MOVE.B  D0,-1(A1)⓪&next:⓪(DBRA    D1,luup⓪&ende:⓪$END⓪"END fileUpper;⓪ ⓪ (*$L+*)⓪ PROCEDURE prepErr (VAR f:File; REF n: ARRAY OF CHAR; VAR myname: ARRAY OF CHAR;⓪3mode:Access; VAR unit0:Unit; VAR disk: BOOLEAN ): BOOLEAN;⓪"⓪"VAR res:LONGINT;⓪"⓪"PROCEDURE checkUnit;⓪$VAR s: ARRAY [0..39] OF CHAR;⓪(ok:BOOLEAN;⓪(unitIdx: Unit;⓪$BEGIN⓪&res:=0L;⓪&FOR unitIdx:= con TO ext7 DO⓪(WITH UnitDriver [unitIdx] DO⓪*Copy (myname,0,Length(name),s,ok);⓪*IF valid & StrEqual (s,name) THEN⓪,IF ORD (mode) < 3 THEN⓪.res := fBadOp⓪,ELSIF ((mode#readSeqTxt) & ~output) OR ((mode=readSeqTxt) & ~input) THEN⓪.res := fBadAccess⓪,END;⓪,disk:= FALSE;⓪,unit0:= unitIdx;⓪,RETURN⓪*END⓪(END⓪&END;⓪&disk:= TRUE⓪$END checkUnit;⓪"⓪"BEGIN⓪$Assign (n,myname,strRes);⓪$IF NOT strRes THEN⓪&f:= OpErr (LONG(fNameTooLarge));⓪&RETURN TRUE⓪$END;⓪$fileUpper (myname);⓪$SysAlloc (f, TSIZE (FileDesc));⓪$IF f=NIL THEN⓪&f := OpErr (LONG(fOutOfMem));⓪&RETURN TRUE⓪$END;⓪$f^.buffer:= NIL;⓪$IF ~ListAppend (f,res) THEN⓪&DEALLOCATE (f,0L);⓪&f := OpErr (res);⓪&RETURN TRUE⓪$END;⓪$checkUnit;⓪$IF res<0L THEN⓪&free (f,res);⓪&RETURN TRUE⓪$END;⓪$Assign (myname,f^.name,strRes);⓪$RETURN FALSE⓪"END prepErr;⓪ ⓪ ⓪ (*$L+*)⓪ PROCEDURE unitOpen (VAR f:File; unit0:Unit): BOOLEAN;⓪"VAR res:INTEGER;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE    unit0(A6),D0⓪(MULU    unitSize,D0⓪(LEA     UnitDriver,A0⓪(ADDA.W  D0,A0⓪(MOVE.L  f(A6),A1⓪(MOVE.L  (A1),A1⓪(MOVE.L  UDriver.wrData(A0),File.uwrite(A1)⓪(MOVE.L  UDriver.wrStr(A0),File.uwrstr(A1)⓪(MOVE.L  UDriver.rdData(A0),File.uread(A1)⓪(MOVE.L  UDriver.rdChr(A0),File.urdchr(A1)⓪(MOVE.W  UDriver.console(A0),File.ucons(A1)⓪(MOVE.L  UDriver.close(A0),File.uclose(A1)⓪(MOVE.L  UDriver.flush(A0),File.uflush(A1)⓪(MOVE.L  UDriver.initHdl(A0),File.uhandle(A1)⓪$END;⓪$WITH f^ DO⓪&unit:= unit0;⓪&res:= UnitDriver[unit].open (uhandle,name); (* 'name' ist auch in Unit *)⓪$END;⓪$IF res<0 THEN⓪&free (f,LONG(res));⓪&RETURN TRUE⓪$ELSE⓪&RETURN FALSE⓪$END⓪"END unitOpen;⓪ ⓪ ⓪ (*$L+*)⓪ PROCEDURE open0 (VAR f         : File;⓪5REF mediumname: ARRAY OF CHAR;⓪5mode      : Access;⓪5level     : INTEGER);⓪"VAR h, n: CARDINAL;⓪&l, res: LONGINT;⓪&myname: ARRAY [0..139] OF CHAR;⓪&append, disk: BOOLEAN;⓪&unit0: Unit;⓪"BEGIN⓪$res:= 0;⓪$IF prepErr (f,mediumname,myname,mode,unit0,disk) THEN RETURN END;⓪$append:= FALSE;⓪$IF disk THEN⓪&ASSEMBLER⓪(MOVE    mode(A6),D0⓪(CMPI    #2,D0⓪(BLS     ok⓪(SUBQ    #3,D0⓪(CMPI    #2,D0           ; appendSeqTxt ?⓪(BNE     ok⓪(MOVEQ   #1,D0           ; writeOnly⓪$ok: MOVE    D0,-(A7)⓪(PEA     myname(A6)⓪(MOVE    #$3D,-(A7)              ; OPEN⓪(TRAP    #1⓪(ADDQ.L  #8,A7⓪(MOVE.L  D0,res(A6)⓪&END;⓪&IF res < 0L THEN⓪(free (f,res);⓪(RETURN⓪&ELSE⓪(IF mode=readSeqTxt THEN⓪*f^.bufsize:= BufferSize;⓪*f^.bufpos:= BufferSize;⓪*SysAlloc (f^.buffer, BufferSize);⓪*IF f^.buffer = NIL THEN⓪,res:= clos (h);⓪,free (f,fOutOfMem);⓪,RETURN⓪*END⓪(END;⓪(h:= SHORT (res);⓪(l:= seek (0L,h,fromEnd);⓪(IF mode=appendSeqTxt THEN⓪*append:= TRUE⓪(ELSE⓪*res:= seek (0L,h,fromBegin)⓪(END;⓪(IF (l<0L) OR (res<0L) THEN⓪*IF l>=0L THEN l:= res END;⓪*res:= clos (h);⓪*free (f,l);⓪*RETURN⓪(END⓪&END⓪$ELSE⓪&IF unitOpen (f,unit0) THEN RETURN END;⓪&l:= 0⓪$END;⓪$WITH f^ DO⓪&ondisk:= disk;⓪&IF ondisk THEN⓪(new:= FALSE;⓪(handle:= h;⓪(modified:= FALSE;⓪&END;⓪&accmode := mode;⓪&IF append THEN pos := l ELSE pos := 0 END;⓪&len := l;⓪&modlevel := level⓪$END;⓪$init0 (f)⓪"END open0;⓪ ⓪ ⓪ (*$L+*)⓪ PROCEDURE create0 (VAR f         : File;⓪7REF mediumname: ARRAY OF CHAR;⓪7mode      : Access;⓪7replMode  : ReplaceMode;⓪7level     : INTEGER);⓪"VAR h, n: CARDINAL;⓪&res: LONGINT;⓪&myname: ARRAY [0..139] OF CHAR;⓪&append, disk: BOOLEAN;⓪&unit0: Unit;⓪"BEGIN⓪$res := 0;⓪$IF (mode=readOnly) OR (mode=readSeqTxt) THEN⓪&f:= OpErr (LONG(fNoReadAllowed));⓪&RETURN⓪$END;⓪$IF prepErr (f,mediumname,myname,mode,unit0,disk) THEN RETURN END;⓪$append := FALSE;⓪$IF disk THEN⓪&ASSEMBLER⓪*MOVE    #writeOnly,-(A7)⓪*PEA     myname(A6)⓪*MOVE    #$3D,-(A7)            ; OPEN⓪*TRAP    #1⓪*ADDQ.L  #8,A7⓪*MOVE.L  D0,res(A6)⓪&END;⓪&IF res>=0L THEN (* Datei existiert *)⓪(IF replMode = noReplace THEN⓪*res := clos (LowerWord(res));⓪*free (f,LONG(fFileExists));⓪*RETURN⓪(ELSE⓪*IF mode#appendSeqTxt THEN⓪,res := clos (LowerWord(res));⓪,del (myname);⓪,res := -33⓪*ELSE⓪,append := TRUE⓪*END⓪(END⓪&END;⓪&IF (res=-33L) OR (res=-34L) THEN⓪(ASSEMBLER⓪*CLR     -(A7)⓪*PEA     myname(A6)⓪*MOVE    #$3C,-(A7)            ; CREATE⓪*TRAP    #1⓪*ADDQ.L  #8,A7⓪*MOVE.L  D0,res(A6)⓪(END⓪&END;⓪&IF res < 0L THEN⓪(free (f,res);⓪(RETURN⓪&END;⓪&h := SHORT (res)⓪$ELSE⓪&IF unitOpen (f,unit0) THEN RETURN END;⓪$END;⓪$WITH f^ DO⓪&ondisk:= disk;⓪&IF ondisk THEN⓪(new:= TRUE;⓪(handle:= h;⓪(modified:= FALSE;⓪&END;⓪&accmode := mode;⓪&IF append THEN⓪(res := seek (0,h,fromEnd);⓪(IF res < 0L THEN⓪*free (f,res);⓪*RETURN⓪(END;⓪(len := res;⓪(pos := res⓪&ELSE⓪(len := 0;⓪(pos := 0;⓪&END;⓪&modlevel := level⓪$END;⓪$init0 (f)⓪"END create0;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE Open (VAR f: File; REF n: ARRAY OF CHAR; m: Access);⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W  ModLevel,(A3)+⓪(JMP     open0⓪$END⓪"END Open;⓪ ⓪ (*$L-*)⓪ PROCEDURE SysOpen (VAR f: File; REF n: ARRAY OF CHAR; m: Access);⓪"BEGIN⓪$ASSEMBLER⓪(MOVE    #-1,(A3)+⓪(JMP     open0⓪$END⓪"END SysOpen;⓪ ⓪ (*$L-*)⓪ PROCEDURE Create (VAR f: File; REF n: ARRAY OF CHAR; m: Access; r: ReplaceMode);⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W  ModLevel,(A3)+⓪(JMP     create0⓪$END⓪"END Create;⓪ ⓪ (*$L-*)⓪ PROCEDURE SysCreate (VAR f: File; REF n: ARRAY OF CHAR; m: Access; r: ReplaceMode);⓪"BEGIN⓪$ASSEMBLER⓪(MOVE    #-1,(A3)+⓪(JMP     create0⓪$END⓪"END SysCreate;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE clRem;⓪"BEGIN⓪$ASSEMBLER⓪(LINK    A5,#0⓪(MOVE    D0,-(A7)⓪(MOVE.L  -(A3),A0⓪(MOVE.L  A0,-(A7)⓪(MOVE.L  (A0),(A3)+⓪(JSR     Opened⓪(TST     -(A3)⓪(BEQ.W   OE⓪(MOVE.L  (A7),A0⓪(MOVE.L  (A0),(A3)+⓪(JSR     @CheckState⓪(TST     -(A3)⓪(BEQ.W   E0⓪(MOVE.L  (A7),(A3)+⓪(JSR     ListRemove⓪(MOVE.L  (A7),A0⓪(MOVE.L  (A0),A1⓪(MOVE.L  A1,D1⓪(BEQ.W   E0⓪(TST     File.ondisk(A1)⓪(BEQ     T0⓪(⓪(; Wenn Close() und Datei nicht neu angelegt, Datum ggf. neu setzen⓪(MOVE    4(A7),D0        ; Remove()?⓪(OR      File.new(A1),D0 ; oder Datei neu angelegt?⓪(BNE     T1⓪(⓪(TST.W   File.modified(A1) ; Datei beschrieben?⓪(BEQ     T1⓪(⓪(; Datum setzen⓪(MOVE.L  A1,(A3)+        ; f⓪(JSR     CurrentDate⓪(JSR     CurrentTime⓪(JSR     SetDateTime⓪(⓪%T1 ; File beim GEMDOS schließen⓪(MOVE.L  (A7),A0⓪(MOVE.L  (A0),A1⓪(MOVE    File.handle(A1),(A3)+⓪(MOVE.L  A1,-(A7)⓪(JSR     clos            ; liefert state.L auf Heap⓪(MOVE.L  (A7)+,A1⓪(⓪(; Wenn Remove() und Datei neu angelegt, Datei löschen⓪(MOVE    4(A7),D0        ; Remove()?⓪(AND     File.new(A1),D0 ; und Datei neu angelegt?⓪(BEQ     T2⓪(⓪(; Datei löschen⓪(CLR.L   -4(A3)⓪(LEA     File.name(A1),A0⓪(MOVE.L  A0,(A3)+⓪(ADDQ.L  #2,A3⓪(JSR     del⓪(BRA     T2⓪(⓪%T0 MOVE.L  File.uhandle(A1),(A3)+⓪(MOVE.L  File.uclose(A1),A2⓪(JSR     (A2)⓪(MOVE.W  -(A3),D0⓪(EXT.L   D0⓪(MOVE.L  D0,(A3)+⓪(⓪%T2 MOVE.L  (A7),A0         ; ADR (f)⓪(MOVE.L  (A0),A1⓪(MOVE.L  File.buffer(A1),D0⓪(BEQ     noBuf⓪(MOVE.L  D0,-(A7)⓪(MOVE.L  A7,(A3)+        ; f.buffer⓪(CLR.L   (A3)+⓪(JSR     DEALLOCATE⓪(ADDQ.L  #4,A7⓪%noBuf⓪(MOVE.L  (A7),(A3)+⓪(CLR.L   (A3)+⓪(JSR     DEALLOCATE⓪(BRA     E1⓪%E0 MOVE.L  (A7)+,A0⓪(CLR.L   (A0)⓪(UNLK    A5⓪(RTS⓪%OE MOVE.L  #fWasNotOpen,(A3)+⓪%E1 JSR     OpErr⓪(MOVE.L  (A7)+,A0⓪(MOVE.L  -(A3),(A0)⓪(UNLK    A5⓪$END⓪"END clRem;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE Close (VAR f: File);⓪"BEGIN⓪$ASSEMBLER⓪(MOVEQ   #0,D0        ; REMOVE nicht möglich⓪(JMP     clRem⓪$END⓪"END Close;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE Remove (VAR f: File);⓪"BEGIN⓪$ASSEMBLER⓪(MOVEQ   #1,D0           ; REMOVE möglich⓪(JMP     clRem⓪$END⓪"END Remove;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE EOF (f: File): BOOLEAN;⓪"BEGIN⓪$ASSEMBLER⓪(; zerstört nur D0/A0, in A0 zuletzt immer File !⓪(MOVE.L  -(A3),D0⓪(MOVE.L  D0,A0⓪(BEQ     TR⓪(TST     File.state(A0)⓪(BMI     TR⓪(CMPI    #3,File.accmode(A0)⓪(BCC     T0⓪(MOVE.L  File.pos(A0),D0⓪(CMP.L   File.len(A0),D0⓪(SCC     D0⓪(ANDI    #1,D0⓪(MOVE    D0,(A3)+⓪(RTS⓪%T0 MOVE    File.eof(A0),(A3)+⓪(RTS⓪%TR MOVE    #1,(A3)+⓪$END⓪"END EOF;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE State (f: File): INTEGER;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L  -(A3),D0⓪(BEQ     ER⓪(MOVE.L  D0,A0⓪(MOVE    File.state(A0),(A3)+⓪(RTS⓪%ER MOVE    #fFileNotOpen,(A3)+⓪$END⓪"END State;⓪ ⓪ ⓪ (*$L+*)⓪ PROCEDURE getSt2 (ad:ADDRESS; n:INTEGER; VAR msg:ARRAY OF CHAR): BOOLEAN;⓪"VAR s: POINTER TO ARRAY [0..31] OF CHAR;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L  ad(A6),A0⓪(MOVE.W  n(A6),D0⓪(⓪%l: CMP.W   (A0)+,D0⓪(BNE     c⓪(⓪(; gefunden⓪(MOVE.L  A0,s(A6)⓪(BRA     e⓪(⓪%c: TST.B   (A0)    ; Listenende ?⓪(BEQ     f       ; Ja, -> nicht gefunden⓪(⓪%m: ADDA.W  #32,A0⓪(BRA     l⓪(⓪%f: CLR.L   s(A6)⓪%e:⓪$END;⓪$IF s#NIL THEN⓪&Assign (s^,msg,strRes);⓪&RETURN TRUE⓪$ELSE⓪&RETURN FALSE⓪$END⓪"END getSt2;⓪ ⓪ (*$L+*)⓪ PROCEDURE GetStateMsg (n: INTEGER; VAR msg: ARRAY OF CHAR);⓪"VAR p:INTEGER;⓪"BEGIN⓪$msg[0]:=0C;⓪$IF FileErrMsg=NIL THEN⓪&Assign ('Unknown error #@',msg,strRes)⓪$ELSE⓪&IF ~getSt2 (FileErrMsg,n,msg) THEN⓪(IF n<0 THEN⓪*IF getSt2 (FileErrMsg,-32768,msg) THEN END⓪(ELSE⓪*IF getSt2 (FileErrMsg,32767,msg) THEN END⓪(END⓪&END;⓪$END;⓪$p:=Pos ('@',msg,0);⓪$IF p>=0 THEN⓪&Delete (msg,p,1,strRes);⓪&Insert (IntToStr(n,0),p,msg,strRes)⓪$END⓪"END GetStateMsg;⓪ ⓪ ⓪ (*$L+*)⓪ PROCEDURE ResetState (VAR f: File);⓪"VAR r: LONGINT;⓪"BEGIN⓪$IF Opened (f) THEN⓪&WITH f^ DO⓪(state := 0;⓪(IF ondisk THEN⓪*r := seek (0L,handle,fromPos);⓪*IF r<0L THEN⓪,state := SHORT (r)⓪*ELSE⓪,pos := r;⓪,r := seek (0L,handle,fromEnd);⓪,IF r<0L THEN⓪.state := SHORT (r)⓪,ELSE⓪.len := r⓪,END⓪*END⓪(END⓪&END⓪$ELSE⓪&f := NIL⓪$END⓪"END ResetState;⓪ ⓪ (*$L-*)⓪ PROCEDURE InErrField (f:ADDRESS):BOOLEAN;⓪"BEGIN⓪$ASSEMBLER⓪(; A0, A1, D1, D2 nicht zerstören !⓪(MOVE.L  -(A3),D0⓪(CMP.L   ErrTblBeg,D0⓪(BCS     FA⓪(CMP.L   ErrTblEnd,D0⓪(BCC     FA⓪(MOVE    #1,(A3)+⓪(RTS⓪%FA CLR     (A3)+⓪$END⓪"END InErrField;⓪ ⓪ (*$L-*)⓪ PROCEDURE @CheckState (f: File): BOOLEAN;⓪"BEGIN⓪$ASSEMBLER⓪(; Am Ende immer File in A0 !  -- A1 nicht zerstören !⓪(MOVE.L  -(A3),D0⓪(BEQ     T6              ; -> file not open⓪(MOVE.L  D0,A0⓪(CMP.L   ErrTblBeg,D0⓪(BCS     T1⓪(CMP.L   ErrTblEnd,D0⓪(BCS     T5⓪%T1 ; 'f' ist nicht im ErrField⓪(TST     File.ondisk(A0)⓪(BEQ     T2⓪(MOVE.L  File.pos(A0),D0⓪(CMP.L   File.len(A0),D0⓪(BLS     T2⓪(MOVE    #fInternalErr1,D2⓪(BRA     T3⓪%T2 MOVE    File.state(A0),D2⓪(BMI     T3⓪(MOVE    #1,(A3)+⓪(RTS⓪%T5 ; 'f' ist im ErrField⓪(MOVE    (A0),D2⓪(BMI     T4⓪(BRA     T6⓪%T3 MOVE.L  A0,(A3)+⓪(MOVEM.L D1/A0,-(A7)⓪(JSR     Opened⓪(MOVEM.L (A7)+,D1/A0⓪(TST     -(A3)⓪(BNE     T4⓪(MOVE.L  A0,(A3)+⓪(JSR     InErrField⓪(TST     -(A3)⓪(BNE     T4⓪%T6 MOVE    #fFileNotOpen,D2⓪%T4 LINK    A5,#0⓪(MOVEM.L D1/A0/A1,-(A7)⓪(MOVE.L  A0,-(A7)⓪(SUBA.W  #TSIZE (ScanDesc),A7⓪(MOVE.L  A7,(A3)+⓪(MOVE    D2,-(A7)⓪(JSR     GetScanAddr⓪(LEA     2(A7),A0⓪(MOVE.L  A0,(A3)+⓪(JSR     ScanBack⓪(SUBQ.L  #2,A3⓪(LEA     14(A7),A0⓪(MOVE.L  A0,(A3)+        ; VAR File⓪(MOVE    (A7)+,(A3)+     ; err-no⓪(MOVE.L  (A7)+,(A3)+     ; ScanDesc⓪(MOVE.L  (A7)+,(A3)+     ; ScanDesc⓪(MOVE.L  (A7)+,(A3)+     ; ScanDesc⓪(MOVE.L  HandleError,A0⓪(JSR     (A0)⓪(ADDQ.L  #4,A7⓪(MOVE.L  4(A7),(A3)+⓪(JSR     Opened⓪(MOVEM.L (A7)+,D1/A0/A1⓪(UNLK    A5⓪$END⓪"END @CheckState;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE AccessMode (f: File): Access;⓪"BEGIN⓪$ASSEMBLER⓪(LINK    A5,#0⓪(JSR     @CheckState⓪(CLR     D0⓪(TST     -(A3)⓪(BEQ     E0⓪(MOVE    File.accmode(A0),D0⓪%E0 MOVE    D0,(A3)+⓪(UNLK    A5⓪$END⓪"END AccessMode;⓪ ⓪ (*$L-*)⓪ PROCEDURE DiskAccess (f: File): BOOLEAN;⓪"BEGIN⓪$ASSEMBLER⓪(LINK    A5,#0⓪(JSR     @CheckState⓪(CLR     D0⓪(TST     -(A3)⓪(BEQ     E0⓪(MOVE    File.ondisk(A0),D0⓪%E0 MOVE    D0,(A3)+⓪(UNLK    A5⓪$END⓪"END DiskAccess;⓪ ⓪ (*$L-*)⓪ PROCEDURE SetEOFMode (f: File; checkChar: BOOLEAN; eofChar: CHAR);⓪"BEGIN⓪$ASSEMBLER⓪(LINK    A5,#0⓪(MOVE.L  -8(A3),(A3)+⓪(JSR     @CheckState⓪(TST     -(A3)⓪(BEQ     E0⓪(SUBQ.L  #1,A3⓪(MOVE.B  -(A3),D0⓪(MOVE.W  -(A3),D1⓪(MOVE.L  -(A3),A0⓪(CMPI    #readSeqTxt,File.accmode(A0)⓪(BEQ     T0⓪(MOVE    #fBadOp,File.state(A0)⓪(MOVE.L  A0,(A3)+⓪(JSR     @CheckState⓪(SUBQ.L  #2,A3⓪(CLR.W   File.state(A0)⓪(UNLK    A5⓪(RTS⓪%T0 MOVE.B  D0,File.eofchr(A0)⓪(MOVE.W  D1,File.chkeof(A0)⓪(CLR     File.eof(A0)⓪(UNLK    A5⓪(RTS⓪%E0 SUBQ.L  #8,A3⓪(UNLK    A5⓪$END⓪"END SetEOFMode;⓪ ⓪ (*$L-*)⓪ PROCEDURE GetEOFMode (f: File; VAR checkChar: BOOLEAN; VAR eofChar: CHAR);⓪"BEGIN⓪$ASSEMBLER⓪(LINK    A5,#0⓪(MOVE.L  -12(A3),(A3)+⓪(JSR     @CheckState⓪(TST     -(A3)⓪(BEQ     E0⓪(SUBQ.L  #1,A3⓪(MOVE.L  -(A3),A1⓪(MOVE.L  -(A3),A2⓪(MOVE.L  -(A3),A0⓪(CMPI    #readSeqTxt,File.accmode(A0)⓪(BEQ     T0⓪(MOVE    #fBadOp,File.state(A0)⓪(MOVE.L  A0,(A3)+⓪(JSR     @CheckState⓪(SUBQ.L  #2,A3⓪(CLR.W   File.state(A0)⓪(UNLK    A5⓪(RTS⓪%T0 MOVE.B  File.eofchr(A0),(A1)⓪(MOVE.W  File.chkeof(A0),(A2)⓪(UNLK    A5⓪(RTS⓪%E0 SUBA.W  #12,A3⓪(UNLK    A5⓪$END⓪"END GetEOFMode;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE Flush (f: File);⓪"BEGIN⓪$ASSEMBLER⓪(LINK    A5,#0⓪(JSR     @CheckState⓪(TST     -(A3)⓪(BEQ     E0⓪(TST     File.ondisk(A0)⓪(BNE     ok⓪(MOVE.L  File.uhandle(A0),(A3)+⓪(MOVE.L  File.uflush(A0),A1⓪(MOVE.L  A0,-(A7)⓪(JSR     (A1)⓪(MOVE.L  (A7)+,A0⓪(MOVE    -(A3),File.state(A0)⓪(UNLK    A5⓪(RTS⓪%ok CLR     File.state(A0)⓪(UNLK    A5⓪%E0⓪$END⓪"END Flush;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE SetDateTime ( f: File; d: Date; t: Time );⓪"BEGIN⓪$ASSEMBLER⓪(LINK    A5,#0⓪(JSR     PackTime⓪(SUBQ    #4,A7⓪(MOVE    -(A3),(A7)⓪(JSR     PackDate⓪(MOVE    -(A3),2(A7)⓪(JSR     @CheckState⓪(TST     -(A3)⓪(BEQ     ende⓪(TST.W   File.ondisk(A0)⓪(BEQ     ende⓪(CLR.W   File.modified(A0)       ; damit Datum nicht bei Close⓪(MOVE.L  A0,-(A7)                ;          nochmal gesetzt wird⓪(MOVE    #1,-(A7)⓪(MOVE    File.handle(A0),-(A7)⓪(PEA     8(A7)⓪(MOVE    #$57,-(A7)⓪(TRAP    #1⓪(ADDA.W  #10,A7⓪ ⓪ (* TOS 1.0 & 1.2 liefern keinen Fehler⓪(MOVEQ   #0,D1⓪(TST.L   D0⓪(BEQ     C⓪(MOVE    D0,D1⓪%C: MOVE    D1,(A0)         ; state⓪ *)⓪(MOVE.L  (A7)+, A0       ; !MS⓪(CLR     (A0)            ; -> state immer auf Null setzen⓪%ende:⓪(UNLK    A5⓪$END⓪"END SetDateTime;⓪ ⓪ (*$L-*)⓪ PROCEDURE GetDateTime ( f: File; VAR d: Date; VAR t: Time );⓪"BEGIN⓪$ASSEMBLER⓪(LINK    A5,#0⓪(MOVE.L  -12(A3),(A3)+⓪(JSR     @CheckState⓪(TST     -(A3)⓪(BEQ     error⓪(CLR.L   -(A7)⓪(CLR     -(A7)⓪(MOVE    File.handle(A0),-(A7)⓪(PEA     4(A7)⓪(MOVE    #$57,-(A7)⓪(TRAP    #1⓪(ADDA.W  #10,A7⓪ ⓪ (* TOS 1.0 & 1.2 liefern keinen Fehler⓪(MOVEQ   #0,D1⓪(TST.L   D0⓪(BEQ     C⓪(MOVE    D0,D1⓪%C: MOVE.L  -12(A3),A0⓪(MOVE    D1,(A0)         ; state⓪ *)⓪(MOVE.L  -12(A3),A0⓪(CLR     (A0)            ; -> state immer auf Null setzen⓪ ⓪(MOVE    (A7)+,(A3)+     ; Time⓪(JSR     UnpackTime⓪(MOVE.L  -(A3),D0⓪(MOVE.W  -(A3),D1⓪(MOVE.L  -(A3),A0⓪(MOVE.W  D1,(A0)+⓪(MOVE.L  D0,(A0)⓪(⓪(MOVE    (A7)+,(A3)+     ; Date⓪(JSR     UnpackDate⓪(MOVE.L  -(A3),D0⓪(MOVE.W  -(A3),D1⓪(MOVE.L  -(A3),A0⓪(MOVE.W  D1,(A0)+⓪(MOVE.L  D0,(A0)⓪(⓪(SUBQ.L  #4,A3⓪(UNLK    A5⓪(RTS⓪ ⓪%err2:⓪(⓪%error:⓪(MOVE.L  -(A3),A0        ; time⓪(CLR.W   (A0)+⓪(CLR.L   (A0)⓪(MOVE.L  -(A3),A0        ; date⓪(MOVE.W  #31,Date.day(A0)⓪(MOVE.W  #12,Date.month(A0)⓪(MOVE.W  #2099,Date.year(A0)⓪(SUBQ.L  #4,A3           ; f⓪(UNLK    A5⓪$END⓪"END GetDateTime;⓪ ⓪ ⓪ (*$L+*)⓪ PROCEDURE GetFileName (f: File; VAR name: ARRAY OF CHAR);⓪"BEGIN⓪$IF Opened (f) THEN⓪&Assign (f^.name,name,strRes);⓪&IF ~strRes THEN⓪(Copy (f^.name,LENGTH(f^.name)-(HIGH(name)+1),HIGH(name)+1,name,strRes);⓪(IF HIGH (name) > 2 THEN⓪*name[0]:= '.';⓪*name[1]:= '.';⓪(END⓪&END⓪$ELSE⓪&ASSEMBLER⓪(MOVE.L  name(A6),A0⓪(CLR.B   (A0)⓪&END⓪$END⓪"END GetFileName;⓪ ⓪ ⓪ (*$L+*)⓪ PROCEDURE releaseLevel;⓪"VAR called: BOOLEAN;⓪&p2: FileList;⓪&f:File;⓪"BEGIN⓪$p2:= OpenFiles;⓪$WHILE p2 # NIL DO⓪&p2^.marked:= FALSE;⓪&p2:= p2^.next⓪$END;⓪$REPEAT⓪&p2:= OpenFiles;⓪&called:= FALSE;⓪&WHILE p2 # NIL DO⓪(IF ~p2^.marked & (p2^.owner^.modlevel >= ModLevel) THEN⓪*WITH p2^ DO⓪,marked:= TRUE;⓪,owner^.state:=0;⓪,CloseFile (owner,owner^.ondisk & owner^.new);⓪,IF Opened (owner) THEN⓪.owner^.state:= 0;⓪.f:= owner; (* wg. VAR-Para bei Close *)⓪.Close (f)⓪,END⓪*END;⓪*called:= TRUE;⓪*p2:= NIL⓪(ELSE⓪*p2:= p2^.next⓪(END⓪&END⓪$UNTIL ~called;⓪"END releaseLevel;⓪ ⓪ (*$L+*)⓪ PROCEDURE ChgLevel (start:BOOLEAN; inChild:BOOLEAN; VAR exitCode:INTEGER);⓪"BEGIN⓪$IF inChild THEN⓪&IF start THEN⓪(INC (ModLevel)⓪&ELSE⓪(releaseLevel;⓪(DEC (ModLevel)⓪&END⓪$END⓪"END ChgLevel;⓪ ⓪ (*$L+*)⓪ PROCEDURE freeSys;⓪"BEGIN⓪$ModLevel:= MinInt;⓪$releaseLevel⓪"END freeSys;⓪ ⓪ VAR p: ADDRESS;⓪$i: INTEGER;⓪$hdl: EnvlpCarrier;⓪$tHdl: TermCarrier;⓪$rHdl: RemovalCarrier;⓪$wsp: MemArea;⓪ ⓪ BEGIN⓪"fileSize:= TSIZE (FileField);⓪"unitSize:= SHORT (SIZE (UnitDriver[con]));⓪"OpenFiles:= NIL;⓪"ModLevel:= 0;⓪"ErrTblBeg:= ADR (ErrorTable);⓪"ErrTblEnd:= ErrTblBeg + SIZE (ErrorTable);⓪"p:= ErrTblBeg;⓪"FOR i:= -MaxWarn TO -MaxErrorNo DO⓪$p^ := WORD(-i);⓪$INC (p,2)⓪"END;⓪"SetEnvelope (hdl,ChgLevel,wsp);⓪"CatchProcessTerm (tHdl,releaseLevel,wsp);⓪"CatchRemoval (rHdl,freeSys,wsp);⓪ END Files.⓪ ə
  2. (* $0000584F$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$0000387D$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$00002812$FFFAD5B5$FFFAD5B5$FFFAD5B5$FFFAD5B5$000028F6Ç$00000564T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00001C02$00001D94$00002B0B$00002A3D$000004ED$0000060B$0000055E$00000608$00000564$000004FF$FFEC668A$00000553$000004FC$00000553$000004FB$00002A95ñÇâ*)
  3.